home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
os2
/
kzr0597.zip
/
KZR.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1997-03-13
|
21KB
|
620 lines
/* REXX-Programm kzr.CMD */
"@ echo off"
Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
Call SysLoadFuncs
/* Wird bei der Ausführung einer REXX-Anweisung ein Syntaxfehler */
/* festgestellt, so wird zur Prozedur "Fehlermeldung" verzweigt. */
signal on syntax name Fehlermeldung
/* Die Datei "Ergebnis.DAT" wird in dem Verzeichnis abgelegt, */
/* in dem auch die Datei "kzr.CMD" abgelegt ist. */
Pfd=SysSearchPath("PATH", "kzr.cmd")
lp=LastPos("\", Pfd)
Pfd=DelStr(Pfd, 1+lp)
buferg=Pfd||"Ergebnis.DAT"
bufND =Pfd||"NDZahl.DAT"
bufNDA=Pfd||"NDAZahl.DAT"
bufMsg=Pfd||"Meldung.DAT"
z = LineIn(buferg, 1)
zv=z
if length(zv)=0 then zv="Keines"
/* Der Befehl "Call charout(buferg)" ist erforderlich, weil sonst */
/* die Datei Ergebnis.DAT, die über den Pfad Pfd erreichbar ist, */
/* nicht gelöscht werden kann. */
Call charout(buferg); Call SysFileDelete buferg
parse arg str; str=strip(str)
if (length(str)= 0) then do; "view.exe" Pfd||"KZR.INF"; EXIT;end
/* Prüfung, ob das e r s t e Komma nach "kzr" eingegeben wurde. */
ww=word(str, 1)
l1=length(ww)
lk=Pos(",", ww)
p1=wordpos(" , ", str)
if l1 <> lk then
do
if p1 = 0 then
do
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Call kommav
end
end
/* Zerlegen des Kommandozeilen-Strings nach eine Schablone. */
/* Das "UPPER" ist wichtig, damit verschiedene Schreibweisen */
/* von "externen" Operatoren, wie z.B. divganz, DivGanz oder */
/* dIVgANZ auch richtig erkannt werden. */
parse UPPER value str with ND ',' st ';' v1 ',' v2
/* v1 ist die Zuweisung für die Variable 1 */
/* und v2 die Zuweisung für die Variable 2. */
/* v1, v2 oder auch v1 unv v2 können nach der Formulierung der */
/* Rechenaufgabe auf der Kommandozeile, jeweils durch ein Komma */
/* getrennt auf der Kommandozeile eingegeben werden. */
/* v1 und v2 müssen aber nicht eingegeben werden, wenn in der */
/* eigentlichen "Rechenaufgabe" keine Variablen vorhanden sind. */
/* Prüfung, ob ND eine gültige REXX-Zahl ist */
if Datatype(ND, N) <> 1 & length(ND) > 0 then
do
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Call FalschZahl ND
end
/* Prüfung, ob ND größer als 1 ist */
if length(ND) > 0 & ND < 2 then
do
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Call FalschArg
end
if length(ND) = 0 then ND = 20
Numeric digits ND
/* Die Variable ND wird an bufND übergeben */
ret=LineOut(bufND, ND)
/* Es wird überprüft, ob die Variablen-Zuweisung auf der */
/* Kommandozeile korrekt ist. */
if length(strip(v1)) > 0 & Pos("=", v1) = 0 then Call NoVar
if length(strip(v2)) > 0 & Pos("=", v2) = 0 then Call NoVar
if Pos("'", st) > 0 | Pos('"', st) > 0 | Pos("@", st) > 0 | ,
Pos("?", st) > 0 | Pos('\', st) > 0 | Pos('#', st) > 0 | ,
Pos('', st) > 0 | Pos('$', st) > 0 then
do
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Call QuoteFilter
end
st1=st
if Pos(":", st1) > 0 then st2=Filter2(st1); else st2=st1
if Pos("DIVGANZ", st2) > 0 then st3=Filter3(st2); else st3=st2
if Pos("DIVREST", st3) > 0 then st4=Filter4(st3); else st4=st3
st=st4
select
when Pos(")0", st) > 0 then Signal twt
when Pos(")1", st) > 0 then Signal twt
when Pos(")2", st) > 0 then Signal twt
when Pos(")3", st) > 0 then Signal twt
when Pos(")4", st) > 0 then Signal twt
when Pos(")5", st) > 0 then Signal twt
when Pos(")6", st) > 0 then Signal twt
when Pos(")7", st) > 0 then Signal twt
when Pos(")8", st) > 0 then Signal twt
when Pos(")9", st) > 0 then Signal twt
when Pos("),", st) > 0 then Signal twt
when Pos(").", st) > 0 then Signal twt
otherwise Signal twtw
end
twt:
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Call Unsinn
twtw:
stst=strip(st)
v1 =strip(v1)
v2 =strip(v2)
/* Wichtig, damit das Ergebnis in der Variablen z verfügbar ist, und */
/* daß zuerst die Variablen v1, v2 oder auch v1 und v2 ügbar ist. */
if length(v1) > 0 & length(v2) > 0 then
do
/* Hier ist zweimal ein Semikolon erforderlich, */
/* da Trennung von drei REXX-Anweisungen */
st=v1||";"||v2||"; "||"z = "||stst
Signal NV
end
if length(v1) > 0 & length(v2) = 0 then
do
/* Hier ist einmal ein Semikolon erforderlich, */
/* da Trennung von zwei REXX-Anweisungen */
st=v1||"; "||"z = "||stst
Signal NV
end
if length(v2) > 0 & length(v1) = 0 then
do
/* Hier ist einmal ein Semikolon erforderlich, */
/* da Trennung von zwei REXX-Anweisungen */
st=v2||"; "||"z = "||stst
Signal NV
end
st ="z = "||stst
NV:
stA="z = "||stst
/* Für die Anzeige der aktuellen Berechnung sollen von kzr.CMD */
/* in große Buchstaben umgewandelte kleinen Buchstaben wieder */
/* in kleine Buchstaben umgewandelt wrden. */
kl="abcdefghijklmnopqrstuvwxyzäöü"; gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
stA=translate(stA, kl, gr)
v1 =translate(v1, kl, gr)
v2 =translate(v2, kl, gr)
say
Numeric Digits ND+4 /* Intern wird mit ND+4 Dezimalstellen gerechnet. */
/* Dies ist der wichtigste Befehl ! */
/**/ interpret st /**/
/* Dies ist der wichtigste Befehl ! */
/* Von NDA_MIN wird der niedrigste Wert NDA für die Rechengenauigkeit */
/* der verwendeten Funktionen ermittelt und dieser "Kernfunktion"kzr.CMD */
/* für die Ergebnisanzeige übergeben. */
ND=MinNDA()
Numeric Digits ND
/* Nur wenn das Ergebnis eine gültige REXX-Zahl ist, Ergebnis formen */
if DataType(z, N) = 1 then
do
Numeric Digits ND
zz=Format(z, , , , )
st10=ErgFormat(zz)
end
else st10=z
/* Ausgabe, wenn ein Ergebnis berechnet werden konnte */
Call Color "White"
Call Charout,"Ergebnis der vorangegangenen Berechnung:"; say; say
Call CsrAttrib "High"; Call Color "Green"
Call Charout," "zv; say; say; say
Call CsrAttrib "Normal"; Call Color "White"
Call Charout,"Aufgabe der aktuellen Berechnung:"
say; say
Call CsrAttrib "High"; Call Color "White"
if length(v1) > 0 then
do
parse value v1 with w1 '=' w2
v1=strip(w1)||" = "||strip(w2)
Call Charout," "v1; say
end
if length(v2) > 0 then
do
parse value v2 with w1 '=' w2
v2=strip(w1)||" = "||strip(w2)
Call Charout," "v2; say
end
Call Charout," "stA; say; say; say
Call CsrAttrib "Normal"; Call Color "White"
Call Charout,"Ergebnis ";
Call CsrAttrib "High";
Call Charout,"z"
Call CsrAttrib "Normal";
Call Charout," der aktuellen Berechnung mit "
Call CsrAttrib "High";
Call Charout,ND
Call CsrAttrib "Normal"
Call Charout," Dezimalstellen:"
say; say
Call CsrAttrib "High"; Call Color "Cyan"
Call Charout," "st10; say
/* Nur bei verschiedenen Ausgabeformaten Ausgabe von zwei Anzeigen. */
if Compare(st10, Format(st10, , , ,0)) <> 0 then
do
Call Charout," "Format(st10, , , ,0)
say
end
Call CsrAttrib "Normal";
ret=LineOut(buferg, st10)
PgmEnd:
Call CsrAttrib "Normal"
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufNDA); Call SysFileDelete bufNDA
Call charout(bufMsg); Call SysFileDelete bufMsg
/* Das REXX-Programm MinNDA.CMD löscht temporäre Dateien, */
/* die von "externen" mathematischen Funktionen hizugefügt wurden. */
Dummy=MinNDA()
ende:
EXIT
/******************************* Prozeduren *********************************/
Filter2:
Procedure
parse arg str
i=1; st2.i=str
Anf2:
j=i+1
l2.i=Pos(":", st2.i)
if l2.i=0 then Signal w2e
st2.j=Overlay("/", st2.i, l2.i)
st2=st2.j
i=i+1
Signal Anf2
w2e:
Return(st2)
Filter3:
Procedure
parse arg str
i=1; st3.i=str
Anf3:
j=i+1
l3.i=Pos("DIVGANZ", st3.i); if l3.i > 0 then Signal w31
w31:
if l3.i=0 then Signal w3e
sub3.i=SubStr(st3.i, l3.i, 7)
st3.i =DelStr(st3.i, l3.i, 7)
if sub3.i=="DIVGANZ" then neu3.i="%"
st3.j=Insert(neu3.i, st3.i, l3.i-1 ); st3=st3.j
i=i+1
signal Anf3
w3e:
Return(st3)
Filter4:
Procedure
parse arg str
i=1; st4.i=str
Anf4:
j=i+1
l4.i=Pos("DIVREST", st4.i); if l4.i > 0 then Signal w41
w41:
if l4.i=0 then Signal w4e
sub4.i=SubStr(st4.i, l4.i, 7)
st4.i =DelStr(st4.i, l4.i, 7)
if sub4.i=="DIVREST" then neu4.i="//"
st4.j=Insert(neu4.i, st4.i, l4.i-1 ); st4=st4.j
i=i+1
signal Anf4
w4e:
Return(st4)
/* Diese Funktion entfernt den Dezimalpunkt und die darauf folgenden */
/* Ziffern "0" , wenn nach diesem Dezimalpunkt nur noch Nullen folgen. */
ErgFormat:
Procedure
arg u
/* Nur wenn das Ergebnis einen Dezimalpunkt enthält */
/* und in der Exponential-Schreibweise vorliegt. */
if Pos(".", u)>0 & Pos("E", u)=0 then
do
/* Ziffern-Reihe aus der Ziffer "0" nach dem Dezimalpunkt entfernen */
do forever
lu=length(u)
if Pos("0", u, lu) > 0 then u=DelStr(u, lu); else leave
end
/* Den Dezimalpunkt entfernen */
lu=length(u)
if Pos(".", u) = lu then u=DelStr(u, lu)
end
Return(u)
NoVar:
say
Call CsrAttrib "High"; Call Color "Red"
Call Charout,"Kein Ergebnis !"; say; say
Call Color "White"
Call Charout,"Sie haben einen algebraisch unsinnigen Ausdruck eingeben"; say
Call Charout,"oder einer Variablen keinen Wert zugewiesen. (NoVar)";say
Call CsrAttrib "Normal"
say
Beep(444, 200); Beep(628,300)
Signal PgmEnd
kommav:
say
Call CsrAttrib "High"; Call Color "white"
Call Charout,"In dem Kommandozeilen-String muß nach dem Teilstring "
Call Color "cyan"
Call Charout,"kzr"; say
Call Color "white"
Call Charout,"mindestens "
Call Color "green"
Call Charout,"1"
Call Color "white"
Call Charout," Leerzeichen enthalten sein."; say
Call Charout,"Darauf folgend, bevor die eigentliche ""Rechenaufgabe"" eingegeben wird,"; say
Call Charout,"entweder";say
Call Charout," ein "
Call Color "cyan"
Call Charout,"einzelnes Komma"
Call Color "white"
Call Charout," mit mindestens "
Call Color "green"
Call Charout,"1"
Call Color "white"
Call Charout," Leerzeichen dahinter,"; say
Call Charout,"oder";say
Call Charout," eine "
Call Color "cyan"
Call Charout,"ganze Zahl > 1"
Call Color "white"
Call Charout,", gefolgt von"; say
Call Charout," einem "
Call Color "cyan"
Call Charout,"einzelnen Komma"
Call Color "white"
Call Charout," mit mindestens "
Call Color "green"
Call Charout,"1"
Call Color "white"
Call Charout," Leerzeichen dahinter."; say; say
Call Charout,"Näheres ist in der "
Call Color "Green"
Call Charout,"kzr.INF"
Call Color "white"
Call Charout," zu finden."
say
Beep(444, 200); Beep(628,300)
Signal PgmEnd
FalschZahl:
say
arg ND
Call CsrAttrib "High"; Call Color "Red"
Call Charout,"Kein Ergebnis !"; say; say
Call Color "White"
Call Charout,"Anstelle einer ganzen Zahl, die größer als 1 sein muß,"; say
Call Charout,"haben Sie den String "
Call Color "cyan"
Call Charout,strip(ND)
Call Color "White"
Call Charout," eingegeben."
Call CsrAttrib "Normal"
say
Beep(444, 200); Beep(628,300)
Signal PgmEnd
FalschArg:
say
Call CsrAttrib "High"; Call Color "yellow"
Call Charout,"In dem Kommandozeilen-String muß zwischen dem Teilstring "
Call Color "cyan"
Call Charout,"kzr"; say
Call Color "yellow"
Call Charout,"und dem ersten "
Call Color "cyan"
Call Charout,"Komma"
Call Color "yellow"
Call Charout," entweder"; say; say
Call Charout,"eine "
Call Color "Green"
Call Charout,"ganze Zahl > 1"
Call Color "Yellow"
Call Charout," oder"; say
Call Charout,"mindestens "
Call Color "Green"
Call Charout,"1"
Call Color "Yellow"
Call Charout," Leerzeichen eingegeben werden."
Call CsrAttrib "Normal"
say
Beep(444, 200); Beep(628,300)
Signal PgmEnd
Fehlermeldung:
ret=SysCurState("OFF")
sf=ErrorText(RC)
Call CsrLeft 10
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call Charout," "; say
Call CsrUp 12
if Pos("Invalid ex", sf) > 0 then
do
sfstr="Sie haben einen algebraisch unsinnigen Ausdruck eingeben,",
" ",
"einer Variablen keinen Wert zugewiesen",
" ",
"oder gar keine mathematische Funktion aufgerufen."
Signal raus
end
if Pos("Arithmetic", sf) > 0 then
do
sfstr="Haben Sie etwa versucht, durch 0 zu dividieren ? ····· Pfui !"
Signal raus
end
if Pos('Unexpected "," or ")"', sf) > 0 then
do
sfstr="Sie haben zuviele rechte Klammern oder ein unzulässiges Komma eingegeben."
Signal raus
end
if Pos("Invalid ch", sf) > 0 then
do
sfstr="Sie haben ein in algebraischen Ausdrücken unzulässiges Symbol eingegeben."
Signal raus
end
if Pos("Unmatched", sf) > 0 & Pos("in expression", sf, 15) > 0 then
do
sfstr="Sie haben zu viele linke Klammern eingegeben."
Signal raus
end
if Pos("Bad arithmetic conversion", sf) > 0 then
do
sfstr=" Sie haben einen algebraisch unsinnigen Ausdruck eingeben",
" ",
" oder einer Variablen keinen Wert zugewiesen.",
" ",
" Möglicherweise aber wollten Sie in der aktuellen Rechenaufgabe",
" ",
" mit der Spezialvariablen z das Ergebnis der (gescheiterten)",
" ",
" vorangegangenen Rechenaufgabe verwenden,",
" ",
" der natürlich noch kein Wert zugewiesen war."
Signal raus
end
if Pos("Routine not", sf) > 0 then
do
sfstr="Die Funktion in diesem Ausdruck kann nicht aufgerufen werden."
Signal raus
end
if Pos("Invalid whole number", sf) > 0 then
do
sfstr=" Entweder werden für die interne Rechengenauigkeit",
" ",
" zu wenig Dezimalstellen verwendet,",
" ",
" oder Sie haben als Exponenten keine ganzen Zahlen eingegeben."
Signal raus
end
if Pos("Unknown command", sf) > 0 then
do
sfstr="Eingabe oder Ergebnis der Berechnung ist keine gültige REXX-Zahl."
Signal raus
end
if Pos("Name starts with number or", sf) > 0 then
do
sfstr="Sie haben einer Variablen keinen Wert zugewiesen. (Name starts with number)"
Signal raus
end
/* Gibt Fehlermeldungen eines Unterprogramms zurück, */
/* die in bufMsg gespeichert sind. */
if Pos("Function did not", sf) > 0 then
do
sfstr=LineIn(bufMsg, 1)
/* Hier besonders wichtig ! */
Call charout(bufMsg); Call SysFileDelete bufMsg
Signal raus
end
raus:
Call CsrAttrib "High"; Call Color "Red"
Call Charout,"Kein Ergebnis !"; say; say
Call Color "White"
Call Charout,sfstr; say
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Beep(444, 200); Beep(628,300)
Signal PgmEnd
Unsinn:
say;
Call CsrAttrib "High"; Call Color "red"
Call charout(bufND); Call SysFileDelete bufND
Call charout(bufMsg); Call SysFileDelete bufMsg
Call Charout,"Kein Ergebnis !"; say; say
Call Color "White"
Call Charout,"Sie haben einen algebraisch unsinnigen Ausdruck eingeben."
say
Beep(444, 200); Beep(628,300)
Signal PgmEnd
QuoteFilter:
say
Call CsrAttrib "High"; Call Color "red"
Call Charout,"Kein Ergebnis !"; say; say
Call Color "White"
Call Charout,"Die Symbole "
Call Color "cyan"; Call Charout,""; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"$"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"="; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"?"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"\"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"@"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"#"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"'"; Call Color "White"; Call Charout," und "
Call Color "cyan"; Call Charout,'"'; say
Call Color "White"
Call Charout,"dürfen auf der Kommandozeile dieses Programms nicht verwendet werden,"; say
Call Charout,"weil sie keine der in der arithmetischen Syntax erlaubten Operatoren sind."; say; say
Call Color "Red"
Call Charout,"Warnung für weitere Eingaben !"; say; say
Call Color "White"
Call Charout,"Die Symbole "
Call Color "cyan"; Call Charout,"%"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"&"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,"<"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,">"; Call Color "White"; Call Charout," und "
Call Color "cyan"; Call Charout,"|"; Call Color "White"
Call Charout," sowie die Strings "
Call Color "cyan"; Call Charout,"<<"; Call Color "White"; Call Charout,", "
Call Color "cyan"; Call Charout,">>"; Call Color "White"; Call Charout," und "
Call Color "cyan"; Call Charout,"//"; say
Call Color "White"
Call Charout,"dürfen auf der OS/2-Kommandozeile nur in bestimmten Fällen verwendet werden;"; say
Call Charout,"nur zeigt "
Call Color "cyan"; Call Charout,"kzr.CMD"; Call Color "White"
Call Charout," bei Verletzung der einschlägigen Regeln"; say
Call Charout,"leider keine diesbezüglichen Meldung an."
say
Beep(444, 200); Beep(628,300)
Signal PgmEnd
/***************************** ANSI-Prozeduren ******************************/
CsrUp: Procedure /* CsrUp(Rows) */
Arg u
Rc = Charout(,D2C(27)"["u"A")
return ""
CsrLeft: procedure
arg l
Rc = Charout(,D2C(27)"["l"D")
Return ""
Color: Procedure
arg F,B
Colors = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
return CHAROUT(,D2C(27)"["WORDPOS(F,COLORS)+29";"WORDPOS(B,COLORS)+39";m")
CsrAttrib: Procedure
Arg A
attr = "NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE"
return CHAROUT(,D2C(27)"["WORDPOS(A,ATTR) - 1";m")
EndAll:
Call Color "White","Black"
Call CsrAttrib "Normal"